; PLUGIN STEP 6: OPTIONS METHOD

(defmeth test-model-proto :options ()
"Args: none
"
  (when (send self :dialog)
  (let* ((mob self)
         (anob self)
         (open-solutions
          (send button-item-proto :new "Open solutions"
                :action #'(lambda ()
                            (send self :read-solutions)
                            )))
         (open-forms
          (send button-item-proto :new "Open forms"
                :action #'(lambda ()
                            (send self :read-forms)
                            )))
         (select-toggle (send choice-item-proto :new (list
                              "Forms variable"
                              "Items") 
                              :value 0))
         (var-text-item (send text-item-proto :new "Selectable Variables"))
         (form-text-item (send text-item-proto :new "Selected Forms Variable"))
         (items-text-item (send text-item-proto :new "Selected Items"))
         (var-list (send current-data :active-variables'(numeric)))
         (form-list (repeat " " 1))
         (items-list (repeat " " (length var-list)))
         (form-nums nil)
         (items-nums nil)
         (weight-num nil)
         (var-list-item (send list-item-proto :new var-list
                              :action #'(lambda () (move-vars &optional dc))))
         (form-list-item (send list-item-proto :new form-list))
         (items-list-item (send list-item-proto :new items-list))
         (ok        (send modal-button-proto :new "OK"))
         (cancel    (send modal-button-proto :new "Cancel"))
         (reg-dialog (send modal-dialog-proto :new
                           (list (list (list select-toggle
                                             var-text-item
                                             var-list-item
                                            (list open-forms open-solutions)
                                             ok cancel
                                             )
                                       (list (list (list form-text-item
                                                         form-list-item))
                                             items-text-item
                                             items-list-item
                                             )))
                           :default-button ok
                           :title "Test Correction"))
         )


    (defmeth ok :do-action ()
      (let ((dialog (send ok :dialog))
            )
        (cond 
          ((and  (null (when form-nums (> form-nums 0)))
                 (send anob :forms))
           (error-message "You need to select a forms variable. This variable indicates which form has answered each case."))
          ((or (not items-nums)
               (= (length items-nums) 0))
           (error-message "You need to select at least an items variable"))
         ((and (when form-nums (> form-nums 0)) (not (send anob :forms)))
           (error-message "You need to select at forms file. This file is a text file that indicates which item corresponds with each item"))
          ((not (send anob :solutions))
           (error-message "You need to select a solutions file."))
          (t 
           (send anob :forms-var
                 (select (send (send anob :data-object) :active-variables '(numeric)) form-nums))
           (send anob :items-vars
                 (select (send (send anob :data-object) :active-variables '(numeric)) items-nums))
           (send dialog :modal-dialog-return t))
          )))

    (defmeth cancel :do-action ()
      (let ((dialog (send cancel :dialog)))
        (send dialog :modal-dialog-return nil)))

    (defmeth var-list-item :do-action (&optional dbl-clk)
      (let* ((n (send self :selection))
             (s (select (send self :slot-value 'list-data) n))
             (m nil))
        (when (and n (not (equal s " ")))
              (cond 
                ((and (= 0 (length form-nums))
                      (= 0 (send select-toggle :value)))
                 (send self :set-text n " ") ;OK
                 (setf m (position " " 
                                   (send form-list-item :slot-value  'list-data)
                                   :test 'equal))
                 (send select-toggle :value 1)
                 (send form-list-item :set-text m s)
                 (setf form-nums (concatenate 'list form-nums (list n))))
                ((= 1 (send select-toggle :value))
                 (send self :set-text n " ") ;OK
                 (setf m (position " " 
                                   (send items-list-item :slot-value  'list-data)
                                   :test 'equal))
                 (send items-list-item :set-text m s)
                 (setf items-nums (concatenate 'list items-nums (list n)))))
              (send self :selection nil))))

    (defmeth form-list-item :do-action (&optional dbl-clk)
      (let* ((n (send self :selection))
             (L (length form-nums))
             (s nil)
             (m nil))
        (when n
              (setf s (select (send self :slot-value 'list-data) n))
              (cond
                ((= L 0)
                 (send self :selection nil))
                ((> L n) 
                 (setf m (select form-nums n))
                 (when (< n (1- L))
                       (dolist (i (iseq n (- L 2)))
                               (send self :set-text i 
                                     (select (send self :slot-value 
                                                   'list-data) (1+ i)))))
                 (send self :set-text (1- L) " ")
                 (send var-list-item :set-text m s)
                 (send self :selection nil)
                 (setf form-nums (remove m form-nums)))))))

    (defmeth items-list-item :do-action (&optional dbl-clk)
      (let* ((n (send self :selection))
             (L (length items-nums))
             (s nil)
             (m nil))
        (when n
              (setf s (select (send self :slot-value 'list-data) n))
              (cond
                ((= L 0)
                 (send self :selection nil))
                ((> L n)
                 (setf m (select items-nums n))
                 (when (< n (1- L))
                       (dolist (i (iseq n (- L 2)))
                               (send self :set-text i 
                                     (select (send self :slot-value
                                                   'list-data) (1+ i)))))
                 (send self :set-text (1- L) " ")
                 (send var-list-item :set-text m s)
                 (send self :selection nil)
                 (setf items-nums (remove m items-nums)))
                (t
                 (send self :selection nil))
                ))))
    (cond 
      ((send reg-dialog :modal-dialog)
       (list form-nums items-nums))
      (t nil))
    )))

(defmeth test-model-proto :read-forms (&optional file-name)
"Args: (file-name) " 
  (let* (
         (file-name (cond
                 (file-name file-name)
                 ((send self :forms-file) (send self :forms-file))
                 (t (open-file-dialog t))))
         (file (open file-name :direction :input))
         (forms (transpose (read-data-columns file)))
         )
    (send self :forms-file file-name)
    (close file)
 
    (send self :forms forms)
    forms
    ))


(defmeth test-model-proto :read-solutions (&optional file-name)
"Args: (file-name) " 
  (let*
    ((file-name 
      (cond
        (file-name file-name)
        ((send self :solutions-file) (send self :solutions-file))
        (t (open-file-dialog t))))
     (file (open file-name :direction :input))
     (solutions (transpose (read-data-columns file)))
     )
    
    (send self :solutions-file file-name)
    (close file)
    
    (send self :solutions solutions)
    solutions
    ))



; PLUGIN STEP 7: ANALYSIS METHOD

(defmeth test-model-proto :analysis ()
  
#|  (let* (
    (data (send self :corrected-matrix-no-nil));matriz de var.acti.numeric
    (nobs (array-dimension data 0))
    (scale (mapcar #'sum (row-list data)));calcula una escala con los puntajes totales 
    (scale-if (column-list (make-array (array-dimensions data)  :initial-contents(mapcar #'- scale  (row-list data)))));calcula las escalas sacando los items de a uno.
    (n-items (array-dimension data 1));calcula numero de items
    (n-items-1 (- n-items 1));numero de items menos 1
    (item-variances  (mapcar #'variance (column-list data)));varianzas de los items  
    (item-std  (mapcar #'standard-deviation (column-list data))) ;std de los items 
     (item-kurtosis  (mapcar #'kurtosis (column-list data))) ;kurtosis items 
         (item-skewness  (mapcar #'skewness (column-list data))) ;skewness items       
    (suma-item-variances (sum item-variances));suma de las varianzas de los items
    (scale-variance (variance scale));varianza de la escala
    (scale-std (standard-deviation scale));std de la escala
    (scale-kurtosis (kurtosis scale))
(scale-kurtosis-if (mapcar #'kurtosis scale-if))
(scale-skewness (skewness scale))
(scale-skewness-if (mapcar #'skewness scale-if))
         (scale-variance-if (mapcar #'variance scale-if));varianza de la escala borrando items.
    (scale-std-if (mapcar #'standard-deviation scale-if));std. de la escala borrando items.
    (suma-item-variances-if (mapcar #'(lambda (x) (-  (sum item-variances) x))item-variances));suma de las varianzas de los items borrando los items
    (item-means (mapcar #'mean (column-list data)));medias de los items
    (scale-mean (mean scale));media de la escala
    (scale-mean-if (mapcar #'mean scale-if));media de la escala si se quitan los items
         (pre-impares (* 2 (iseq n-items)))
         (pares (reverse (set-difference (iseq n-items) pre-impares)))
     (impares (reverse (set-difference (iseq n-items) pares)))
         (item-impares  (select (column-list data) impares))
         (impares-matrix (make-array (list (length impares) nobs) :initial-contents item-impares))
         (item-pares  (select (column-list data) pares))
         (pares-matrix (make-array (list (length pares) nobs)  :initial-contents item-pares))
         (scale-pares (mapcar #'sum (column-list  pares-matrix)))
         (scale-impares (mapcar #'sum (column-list  impares-matrix)))
         
         (orden-data (transpose (make-array (list n-items nobs) :initial-contents 
                                            (mapcar #'sort-data (column-list data)))))
         (data-index (mapcar #'remove-duplicates (column-list orden-data)))
         (pre-control (mapcar #'length data-index))
         (control-dicotomico (compare pre-control (repeat 2  n-items)))
         (incorr-data (cond 
                        ((= control-dicotomico 1) 
                         (mapcar #'(lambda (x) (position '1 x) )
                                 (column-list orden-data)))
                        (t nil)))
         (corr-data (cond 
                      ((= control-dicotomico 1) 
                       (mapcar #'(lambda (x) (- nobs x)) incorr-data))
                      (t nil)))
         (p (cond 
              ((= control-dicotomico 1)
               (mapcar #'(lambda (x) (/ x nobs)) corr-data))
              (t nil)))
         (q (cond 
              ((= control-dicotomico 1) 
               (mapcar #'(lambda (x)(- 1 x)) p))
              (t nil)))
         (kuder (cond 
                  ((= control-dicotomico 1)
                   (* (/ n-items (- n-items 1))
                      (- 1 (/ (sum (* p q)) scale-variance))))
                  (t nil)))

         (p*q-if (cond 
                   ((= control-dicotomico 1)
                    (mapcar #'(lambda (x) 
                                (- (sum (* p q)) x)) (* p q)))
                   (t nil)))
         (kuder-if (cond 
                     ((and (= control-dicotomico 1) (> n-items-1 1))
                      (mapcar #'(lambda (x y) 
                                  (* (/ n-items-1 (- n-items-1 1))
                                     (- 1 (/ (sum x) y))))  p*q-if scale-variance-if))
                     (t nil)))
         
         (split-half  (/ (* 2 (correlation scale-pares scale-impares)) 
                         (+ 1 (correlation scale-pares scale-impares))))

         (alfa (* 
            (/ n-items n-items-1)
               (- 1 (/ suma-item-variances scale-variance))));Cronbach's Alfa para la escala
    
         (alfa-if (when (> n-items-1 1)
	(mapcar #'(lambda
                          (suma-item-variances-if scale-variance-if)
                        (* 
            (/ n-items-1 (- n-items-1 1))
               (- 1 (/ suma-item-variances-if scale-variance-if))))
                      suma-item-variances-if scale-variance-if)));alfa si se quitan los items
         )
    (send self :Split-Half Split-Half)
    (send self :scale-pares scale-pares)
    (send self :scale-impares scale-impares)      
   ; (send self :data data)  
    (send self :scale scale)
    (send self :scale-if scale-if)
    (send self :n-items n-items)
    (send self :item-variances item-variances)
    (send self :item-std item-std)
    (send self :item-kurtosis item-kurtosis)
    (send self :item-skewness item-skewness)
    (send self :scale-variance scale-variance)
    (send self :scale-variance-if  scale-variance-if)
    (send self :scale-std scale-std)
    (send self :scale-skewness scale-skewness)
    (send self :scale-skewness-if scale-skewness-if)
    (send self :scale-kurtosis scale-kurtosis)
    (send self :scale-kurtosis-if scale-kurtosis-if)
    (send self :scale-std-if scale-std-if)
    (send self :item-means item-means)
    (send self :scale-mean scale-mean)
    (send self :scale-mean-if scale-mean-if)
    (send self :alfa alfa)
    (send self :alfa-if alfa-if)
    (send self :kuder kuder)
    (send self :kuder-if kuder-if)
    (send self :p p)    
    (send self :q q)
    (send self :p*q-if p*q-if)
    (send self :data-index data-index)
    (send self :control-dicotomico control-dicotomico))|#
  )




(defmeth test-model-proto :rearrange-test (var-formas test-data correspondence labels)
  (let* (
         (var-formas (if (first var-formas)
                         var-formas
                         (repeat '1 (array-dimension test-data 0))))
         (formas (sort-data (remove-duplicates var-formas :test '=)))
         (indexformas (mapcar 'which 
                              (mapcar #'(lambda (forma)
                                          (= var-formas forma))
                                      formas)))
         (test-data test-data)               
         (test-corrected nil)
         (temp nil)
         (formas2 nil)
         (labels2 nil)
         (index-answers (if correspondence
                            (append (list (iseq (array-dimension test-data 1))) 
                                    correspondence)
                            (list (iseq (array-dimension test-data 1)))))
         (index-cases (iseq (array-dimension test-data 0)))
         (index-cases2 nil)
         )
    (dotimes
     (j (length formas))
     (setf temp (mapcar #'(lambda (ind) (select
                                         (col test-data ind :list t)
                                         (select indexformas j)))
                        (select index-answers j)))
     (setf formas2 (append formas2 (select
                                    (coerce var-formas 'list)
                                    (select indexformas j))))
     (setf labels2 (append labels2 (select
                                    (coerce labels 'list)
                                    (select indexformas j))))
     (setf index-cases2 
           (append index-cases2 
                   (select
                    (coerce index-cases 'list)
                    (select indexformas j))))
     (if test-corrected     
         (setf test-corrected
               (bind-columns
                test-corrected
                (make-array (list (length temp) 
                                  (length (first temp))) 
                            :initial-contents temp)))
         (setf test-corrected  
               (make-array (list (length temp) 
                                 (length (first temp))) 
                           :initial-contents temp)))
     (setf temp nil))
    (setf labels2 (sort-and-permute index-cases2 (bind-columns labels2)))
    (setf formas2 (sort-and-permute index-cases2 (bind-columns formas2)))
    (setf test-corrected (sort-and-permute index-cases2 (transpose test-corrected)))
    (list (combine labels2 ) (combine formas2) test-corrected)))




(defmeth test-model-proto :correct-test (test-corrected correct-answers)
  (make-array (list (array-dimension test-corrected 0)
                    (array-dimension test-corrected 1)
                    )
              :initial-contents 
              (mapcar #'(lambda (row)                                  
                          (mapcar #'(lambda (response correct-response)
                                      (cond 
                                        ((null response)  nil)
                                        ((when (= response  correct-response) 1))
                                        (t 0)
                                        ))
                                  (coerce row 'list) correct-answers))
                      (row-list test-corrected))))


(defmeth test-model-proto :count-test (test-corrected &optional exclude-var)
  (let*
    (
     
     (test-corrected (if exclude-var 
                         (bind-columns
                          (select test-corrected 
                                  (iseq (array-dimension test-corrected 0))                               
                                  (remove exclude-var
                                          (iseq (array-dimension test-corrected 1)))))
                         test-corrected))
     (row-list-test-corrected (row-list test-corrected))
     (right (mapcar #'(lambda (case) (count '1 case))
                    row-list-test-corrected))
     (wrong (mapcar #'(lambda (case) (count '0 case))
                    row-list-test-corrected))
     (blank    (mapcar #'(lambda (case) (count 'nil case))
                       row-list-test-corrected))
               )
    (list right wrong blank)))

(defmeth test-model-proto :compute-corrections ()
  (when (send self :solutions-file)(send self :read-solutions))
  (when (send self :forms-file) (send self :read-forms))
  (let* 
    (
     
     (form-nums (position (first (send self :forms-var))
                          (send (send self :data-object) 
                                :active-variables '(numeric))))
     (items-nums 
      (non-missing 
       (mapcar #'(lambda (pos) 
                  (position pos (send (send self :data-object) 
                                  :active-variables '(numeric))))
              (send self :items-vars))))
     (data-matrix (send (send self :data-object) :active-data-matrix '(all)))
                             
     (rearrange   
      (send self :rearrange-test 
            (combine 
             (if form-nums
                 (col data-matrix form-nums)
                 (list
                  (repeat '1 (array-dimension data-matrix 0)))))
            (apply 'bind-columns
                   (col data-matrix
                        items-nums))
            (1- (send self :forms));aqu’ se indica la correspondencia entre los tests
            (send (send self :data-object) :active-labels)
            ))
     (labels (first rearrange))
     (formas (second rearrange))
     (formas-cases 
      (mapcar 'which
              (mapcar #'(lambda (form) 
                          (mapcar #'(lambda (var) (= form var))
                                  formas))
                      (sort-data (remove-duplicates formas :test '=)))))

     (matrix-rearranged-nil (apply 'bind-rows  
                             (split-list
                              (mapcar #'(lambda (val)
                                          (if (equal val 'nil)
                                                   val
                                                   (if (= val 0)
                                                            nil
                                                            val)
                                                   ))
                                      (combine (third rearrange)))
                              (array-dimension (third rearrange) 1))))

     (cor-test 
      (apply 'bind-rows
             (mapcar #'(lambda (solutions form-case)
                         (send self :correct-test  
                               (apply 'bind-rows (row matrix-rearranged-nil form-case))
                               solutions))
                     (send self :solutions) formas-cases)))
     (cor-test (sort-and-permute (combine formas-cases) cor-test))
     (ct-test (send self :count-test cor-test))
     (number-alternatives (mapcar #'(lambda (item) 
                                      (length (remove-duplicates (non-missing
                                                                  (coerce item 'list)))))
                                  (column-list matrix-rearranged-nil)))
     )
    (send self :corrected-matrix cor-test)
    (send self :corrected-matrix-no-nil  
          (make-array (array-dimensions cor-test)
                      :initial-contents (mapcar #'(lambda (el) (if el el 0))
                                                (combine cor-test))))
    (send self :right-num (first ct-test))
    (send self :wrong-num (second ct-test))
    (send self :null-num (third ct-test))
    (send self :num-alternatives number-alternatives)
    ))
    



; PLUGIN STEP 7: REPORT

(defmeth test-model-proto :report 
  (&key (dialog nil))
  (send self :compute-corrections)
  (let* (
         ;(result (- (send self :right-num)
          ;          (/ (send self :wrong-num) nvar)))
         (mat (bind-columns 
               ;result
               (send self :right-num)
               (send self :wrong-num)
               (send self :null-num)
               ))
         (name-variable (list "Correct" "Uncorrect" "Null"))
         (labels (send (send self :data-object) :active-labels))
         (w (report-header "Test Results" :page t))
         )

      (pv-print-matrix-to-window 
       mat w :decimals 2
       :row-labels labels
       :column-labels name-variable
       :row-heading "Subjects    "
       :column-heading ""
                 )))
  

; PLUGIN STEP 8 :CREATE DATA

(defmeth test-model-proto :create-data (&key (dialog nil))
  (send self :compute-corrections)
  (let (
        (name (send self :name))
        (created (send *desktop* :selected-icon))
        (creator-object self)
        (title (send self :title))
        (labels (send self :labels))
        )
  (data (strcat "Results" name)
   :created created
   :creator-object creator-object
   :title (strcat "Results" title)
   :data  (combine (bind-columns (send self :right-num) 
                                 (send self :wrong-num) 
                                 (send self :null-num)))
   :variables (list "Right" "Wrong" "Null")
          :labels labels
          :types (repeat "Numeric" 3)
    )
  (data (strcat "Corrected Matrix" name)
   :created created
   :creator-object self
   :title (strcat "Corrected Matrix" title)
   :data  (combine (send self :corrected-matrix-no-nil))
   :variables (send self :items-vars)
          :labels labels
          :types (repeat "Numeric" 
                         (array-dimension 
                          (send self :corrected-matrix) 1)))
    )
  )

; PLUGIN STEP 9: VISUALIZATION METHOD


(defmeth test-model-proto :visualize (&key dialog)
  )



(provide "testplg2")